perm filename LC4.BB[206,LSP]2 blob sn#260924 filedate 1977-02-01 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00021 ENDMK
C⊗;

.BEGIN NOFILL
.VARIABLE CHW
.CHW ← CHARW
.TURN OFF "βα#\←∞↑↓∪"
.TURN ON "∂{%"
.TURN ON "/" FOR "α"
.AT "∂∂(" CH ")" ⊂ CHARW←CH}∂(2){CHARW←CHW ⊃


∂∂(48)%2compl %2file (FEXPR) ← 
∂∂(80)%3prog [%2z]
∂∂(153)%2eval OUTPUT . [ `DSK:'  . <%3a %2file . LAP>]
∂∂(153)%2eval INPUT . [ `DSK:'  . %2file]
∂∂(153)%2inc[T, NIL]
∂∂(153)%2outc[T, NIL]
∂∂(91)%2loop %2z ← %2errset %2read[]
∂∂(153)%3if %3at %2z %3then %2go %2done %3else if T %3then NIL
∂∂(153)%2z ← %3a %2z
∂∂(153)%3if %3a %2z %3eq DE ∨ [%3a %2z %3eq DEFPROP ∧ %3addd %2z %3eq EXPR] %3then 
∂∂(185)[%3prog [%2prog]
∂∂(267)%2prog
∂∂(283)← [%3if %3a %2z %3eq DE %3then %2comp[%3ad %2z, %3add %2z, %3addd %2z]
∂∂(321)%3else %2comp[%3ad %2z, %3ad %3add %2z, %3add %3add %2z]]
∂∂(267)%2mapc[%2print, %2prog]
∂∂(267)%2outc[NIL, NIL]
∂∂(267)%2print <%3ad %2z, %2length %2prog>
∂∂(267)%2outc[T, NIL]]
∂∂(169)%3else %2print %2z
∂∂(153)%2go %2loop
∂∂(85)%2done %2outc[NIL, T]
∂∂(153)%2inc[NIL, T]
∂∂(153)%2return ENDCOMP



∂∂(48)%2comp[%2fn, %2vars, %2exp] ← 
∂∂(80)/{%2prup[%2vars, 1], %2length %2vars}[λ%2vpr, %2n. 
∂∂(112)%2flat[<<<LAP, %2fn, SUBR>>, 
∂∂(185)%2mkpush[%2n, 1], 
∂∂(185)%2compexp[%2exp, -%2n, %2vpr], 
∂∂(185)%2substack %2n, 
∂∂(185)((POPJ P) (LABEL NIL))>, 
∂∂(167)NIL]]



∂∂(48)%2substack %2n ← %3if %2n %3eq 0 %3then NIL %3else <<SUB, P, <C, %2n, 0, %2n, 0>>>



∂∂(48)%2prup[%2vars, %2n] ← %3if %3n %2vars %3then NIL %3else [%3a %2vars . %2n] . %2prup[%3d %2vars, %2n + 1]



∂∂(48)%2mkpush[%2n, %2m] ← %3if %2n < %2m %3then NIL %3else <PUSH, P, %2m> . %2mkpush[%2n, %2m + 1]



∂∂(48)%2compexp[%2exp, %2m, %2vpr] ← 
∂∂(80)%3if %3n %2exp %3then ((MOVEI 1 0))
∂∂(80)%3else if %2exp %3eq T ∨ %2numberp %2exp %3then <<MOVEI, 1, <QUOTE, %2exp>>>
∂∂(80)%3else if %3at %2exp %3then <<MOVE, 1, %2m + %3d %2assoc[%2exp, %2vpr], P>>
∂∂(80)%3else if %3a %2exp %3eq CAR %3then 
∂∂(112)[%3if %3at %3ad %2exp %3then << `HLRZ@' , 1, %2m + %3d %2assoc[%3ad %2exp, %2vpr], P>>
∂∂(121)%3else <%2compexp[%3ad %2exp, %2m, %2vpr], (( `HLRZ@'  1 1))>]
∂∂(80)%3else if %3a %2exp %3eq CDR %3then 
∂∂(112)[%3if %3at %3ad %2exp %3then << `HRRZ@' , 1, %2m + %3d %2assoc[%3ad %2exp, %2vpr], P>>
∂∂(121)%3else <%2compexp[%3ad %2exp, %2m, %2vpr], (( `HRRZ@'  1 1))>]
∂∂(80)%3else if %3a %2exp %3eq AND ∨ %3a %2exp %3eq OR ∨ %3a %2exp %3eq NOT ∨ %3a %2exp %3eq EQ %3then 
∂∂(112)/{%2gensym[], %2gensym[]}[λ%2l1, %2l2. 
∂∂(144)<%2combool[%2exp, %2m, %2l1, NIL, %2vpr], 
∂∂(162)<(MOVEI 1 (QUOTE T)), <JRST, 0, %2l2>, <LABEL, %2l1>, (MOVEI 1 0), <LABEL, %2l2>>>]
∂∂(80)%3else if %3a %2exp %3eq COND %3then %2comcond[%3d %2exp, %2m, %2gensym[], %2vpr]
∂∂(80)%3else if %3a %2exp %3eq QUOTE %3then <<MOVEI, 1, %2exp>>
∂∂(80)%3else if %3at %3a %2exp %3then <%2complisa[%3d %2exp, %2m, %2vpr], <<CALL, %2length %3d %2exp, <E, %3a %2exp>, S>>>
∂∂(80)%3else if %3aa %2exp %3eq LAMBDA %3then 
∂∂(112)/{%2length %3d %2exp}[λ%2n. 
∂∂(144)<%2stackup[%3d %2exp, %2m, %2vpr], 
∂∂(162)%2compexp[%3adda %2exp, %2m - %2n, %2apend[%2prup[%3ada %2exp, 1 - %2m], %2vpr]], 
∂∂(162)%2substack %2n>]
∂∂(80)%3else if T %3then NIL



∂∂(48)%2stackup[%2u, %2m, %2vpr] ← 
∂∂(80)%3if %3n %2u %3then NIL %3else <%2compexp[%3a %2u, %2m, %2vpr], ((PUSH P 1)), %2stackup[%3d %2u, %2m - 1, %2vpr]>



∂∂(48)%2ccchain %2exp ← [%3a %2exp %3eq CAR ∨ %3a %2exp %3eq CDR] ∧ [%3at %3ad %2exp ∨ %2ccchain %3ad %2exp]



∂∂(48)%2compc[%2exp, %2n2, %2m, %2vpr] ← 
∂∂(80)%3if %3at %2exp %3then %2err COMPC
∂∂(80)%3else if %3a %2exp %3eq CAR %3then 
∂∂(112)[%3if %3at %3ad %2exp %3then << `HLRZ@' , %2n2, %2m + %3d %2assoc[%3ad %2exp, %2vpr], P>>
∂∂(121)%3else < `HLRZ@' , %2n2, %2n2> . %2compc[%3ad %2exp, %2n2, %2m, %2vpr]]
∂∂(80)%3else if %3at %3ad %2exp %3then << `HRRZ@' , %2n2, %2m + %3d %2assoc[%3ad %2exp, %2vpr], P>>
∂∂(80)%3else < `HRRZ@' , %2n2, %2n2> . %2compc[%3ad %2exp, %2n2, %2m, %2vpr]



∂∂(48)%2comcond[%2u, %2m, %2l, %2vpr] ← 
∂∂(80)%3if %3n %2u %3then <<LABEL, %2l>>
∂∂(80)%3else if ¬%3at %3aa %2u ∧ %3aaa %2u %3eq NULL ∧ %3n %3ada %2u %3then 
∂∂(112)<%2compexp[%3adaa %2u, %2m, %2vpr], <<JUMPE, 1, %2l>>, %2comcond[%3d %2u, %2m, %2l, %2vpr]>
∂∂(80)%3else if %3aa %2u %3eq T %3then <%2compexp[%3ada %2u, %2m, %2vpr], <<LABEL, %2l>>>
∂∂(80)%3else /{%2gensym[]}[λ%2l1. 
∂∂(112)<%2combool[%3aa %2u, %2m, %2l1, NIL, %2vpr], 
∂∂(130)%2compexp[%3ada %2u, %2m, %2vpr], 
∂∂(130)<<JRST, 0, %2l>, <LABEL, %2l1>>, 
∂∂(130)%2comcond[%3d %2u, %2m, %2l, %2vpr]>]



∂∂(48)%2complisa[%2u, %2m, %2vpr] ← 
∂∂(80)/{%2classify %2u}[λ%2z. 
∂∂(112)<%2complis[%2z, %2m, 1, %2vpr], %2loadac[%2z, 1 - %2ccount %2z, 1, %2m - %2ccount %2z, %2vpr], %2substack %2ccount %2z>]



∂∂(48)%2ccount %2z ← %3if %3n %2z %3then 0 %3else if %3aa %2z %3eq 4 %3then 1 + %2ccount %3d %2z %3else %2ccount %3d %2z



∂∂(48)%2loadac[%2z, %2m2, %2n2, %2m, %2vpr] ← 
∂∂(80)%3if %3n %2z %3then NIL
∂∂(80)%3else if %3aa %2z %3eq 1 %3then 
∂∂(112)<MOVE, %2n2, %2m + %3d %2assoc[%3da %2z, %2vpr], P> . %2loadac[%3d %2z, %2m2, %2n2 + 1, %2m, %2vpr]
∂∂(80)%3else if %3aa %2z %3eq 0 %3then <MOVEI, %2n2, <QUOTE, %3da %2z>> . %2loadac[%3d %2z, %2m2, %2n2 + 1, %2m, %2vpr]
∂∂(80)%3else if %3aa %2z %3eq 2 %3then <MOVEI, %2n2, %3da %2z> . %2loadac[%3d %2z, %2m2, %2n2 + 1, %2m, %2vpr]
∂∂(80)%3else if %3aa %2z %3eq 3 %3then <%2reverse %2compc[%3da %2z, %2n2, %2m, %2vpr], %2loadac[%3d %2z, %2m2, %2n2 + 1, %2m, %2vpr]>
∂∂(80)%3else if %3aa %2z %3eq 5 %3then %2loadac[%3d %2z, 1, %2n2 + 1, %2m, %2vpr]
∂∂(80)%3else <MOVE, %2n2, %2m2, P> . %2loadac[%3d %2z, %2m2 + 1, %2n2 + 1, %2m, %2vpr]



∂∂(48)%2complis[%2z, %2m, %2k, %2vpr] ← 
∂∂(80)%3if %3n %2z %3then NIL
∂∂(80)%3else if %3aa %2z %3eq 4 %3then <%2compexp[%3da %2z, %2m, %2vpr], ((PUSH P 1)), %2complis[%3d %2z, %2m - 1, %2k + 1, %2vpr]>
∂∂(80)%3else if %3aa %2z %3eq 5 %3then <%2compexp[%3da %2z, %2m, %2vpr], %3if %2k %3eq 1 %3then NIL %3else <<MOVE, %2k, 1>>>
∂∂(80)%3else %2complis[%3d %2z, %2m, %2k + 1, %2vpr]



∂∂(48)%2classify %2u ← %2class2[%2class1[%2u, NIL], NIL, T]



∂∂(48)%2class1[%2u, %2v] ← 
∂∂(80)%3if %3n %2u %3then %2v
∂∂(80)%3else if %3at %3a %2u %3then 
∂∂(112)[%3if %2equal[%3a %2u, NIL] ∨ %2equal[%3a %2u, T] ∨ %2numberp
	%3a %2u %3then %2class1[%3d %2u, [0 . %3a %2u] . %2v]
∂∂(121)%3else %2class1[%3d %2u, [1 . %3a %2u] .
%2v]] ∂∂(80)%3else if %2equal[%3aa %2u, QUOTE] %3then
%2class1[%3d %2u, [2 . %3a %2u] . %2v] ∂∂(80)%3else
if %2ccchain %3a %2u %3then %2class1[%3d %2u, [3 . %3a
%2u] . %2v] ∂∂(80)%3else %2class1[%3d %2u, [4 . %3a
%2u] . %2v]



∂∂(48)%2class2[%2u, %2v, %2flg] ← ∂∂(80)%3if %3n %2u
%3then %2v ∂∂(80)%3else if %2flg ∧ %3aa %2u %3eq 4 %3then
%2class2[%3d %2u, [5 . %3da %2u] . %2v, NIL]
∂∂(80)%3else %2class2[%3d %2u, %3a %2u . %2v, %2flg]



∂∂(48)%2mkjrst %2l ← <<JRST, 0, %2l>>



∂∂(48)%2combool[%2p, %2m, %2l, %2flg, %2vpr] ← 
∂∂(80)%3if %2p %3eq T %3then [%3if %2flg %3then %2mkjrst %2l %3else NIL]
∂∂(80)%3else if %3at %2p %3then <%2compexp[%2p, %2m, %2vpr], <<%3if %2flg %3then JUMPN %3else JUMPE, 1, %2l>>>
∂∂(80)%3else if %3a %2p %3eq EQ %3then 
∂∂(112)<%2complisa[%3d %2p, %2m, %2vpr], %3if %2flg %3then ((CAMN 1 2)) %3else ((CAME 1 2)), %2mkjrst %2l>
∂∂(80)%3else if %3a %2p %3eq AND %3then 
∂∂(112)[%3if ¬%2flg %3then %2compandor[%3d %2p, %2m, %2l, NIL, %2vpr]
∂∂(121)%3else /{%2gensym[]}[λ%2l1. <%2compandor1[%3d %2p, %2m, %2l1, %2l, NIL, %2vpr], <<LABEL, %2l1>>>]]
∂∂(80)%3else if %3a %2p %3eq OR %3then 
∂∂(112)[%3if %2flg %3then %2compandor[%3d %2p, %2m, %2l, T, %2vpr]
∂∂(121)%3else /{%2gensym[]}[λ%2l1. <%2compandor1[%3d %2p, %2m, %2l1, %2l, T, %2vpr], <<LABEL, %2l1>>>]]
∂∂(80)%3else if %3a %2p %3eq NOT %3then %2combool[%3ad %2p, %2m, %2l, ¬%2flg, %2vpr]
∂∂(80)%3else if %3a %2p %3eq NULL %3then 
∂∂(112)<%2compexp[%3ad %2p, %2m, %2vpr], <<%3if %2flg %3then JUMPE %3else JUMPN, 1, %2l>>>
∂∂(80)%3else <%2compexp[%2p, %2m, %2vpr], <<%3if %2flg %3then JUMPN %3else JUMPE, 1, %2l>>>



∂∂(48)%2compandor[%2u, %2m, %2l, %2flg, %2vpr] ← 
∂∂(80)%3if %3n %2u %3then NIL %3else <%2combool[%3a %2u, %2m, %2l, %2flg, %2vpr], %2compandor[%3d %2u, %2m, %2l, %2flg, %2vpr]>



∂∂(48)%2compandor1[%2u, %2m, %2l, %2l2, %2flg, %2vpr] ← 
∂∂(80)%3if %3n %2u %3then %2mkjrst %2l2
∂∂(80)%3else if %3n %3d %2u %3then %2combool[%3a %2u, %2m, %2l2, ¬%2flg, %2vpr]
∂∂(80)%3else <%2combool[%3a %2u, %2m, %2l, %2flg, %2vpr], %2compandor1[%3d %2u, %2m, %2l, %2l2, %2flg, %2vpr]>



∂∂(48)%2flat[%2u, %2s] ← 
∂∂(80)%3if %3n %2u %3then %2s
∂∂(80)%3else if %3n %3a %2u %3then %2flat[%3d %2u, %2s]
∂∂(80)%3else if %3a %2u %3eq LABEL %3then %3ad %2u . %2s
∂∂(80)%3else if %3at %3a %2u %3then %2u . %2s
∂∂(80)%3else %2flat[%3a %2u, %2flat[%3d %2u, %2s]]

.END